1 REM  DISKMAP - SHOWS 1541 ETC FILE STRUCTURE (AND ERRORS)
2 REM AUTHOR A.R. PEPPER - LAST MODIFIED MAR 7, 1984  BY A.R. PEPPER
10 GOTO 9000
190 REM /*
191 REM  * GOSUB 200
192 REM  * SPECIALIZED SUBROUTINE FOR CONVERTING AND PRINTING SECTOR NUMBERS
193 REM  * REQUIRES: A(TRACK) AND B(SECTOR) AS INPUT
195 REM  * SETS: A$ AS OUTPUT  "(T,S)"
196 REM  * CHANGES: B$
197 REM  */
200 A$=STR$(A): B$=STR$(B)
210 A$="("+RIGHT$(A$,LEN(A$)-1)+","+RIGHT$(B$,LEN(B$)-1)+")"
230 RETURN
311 REM /*
312 REM  * GOSUB 315 - CHECK DISK ERROR STATUS BY READING FILE 15
313 REM  *   IT IS ASSUMED THAT THE CALLER WILL USE STATUS AS WANTED
314 REM  */
315 INPUT#15,EN,EM$,ET,ES: RETURN
411 REM /*
412 REM  * GOSUB 415 - CHECK DISK STATUS AND ABORT IF NON-ZERO
413 REM  */
415 GOSUB 315: IF EN=0 THEN RETURN
420 PRINT"DISK ERROR";EN;EM$;ET;ES;"--PROGRAM ABORTED": GOTO 63900
491 REM /*
492 REM  * GOSUB 500 - RETURN FILENAME A FROM NAME TABLE, APPENDING EXTENSION
493 REM  *   NAME IS RETURNED IN S$; A IS CHANGED
494 REM  */
500 S$=DN$(A)+",": A=DE%(A)
510 IF (A AND 127)>4 THEN S$=S$+TY$(4): GOTO 530
520 S$=S$+TY$(A AND 127)
530 IF (A AND 128)=0 THEN S$=S$+"*"
540 RETURN
591 REM /*
592 REM  * GOSUB 600 - CONVERT BF%(T,S)+BU%(T,S,*) TO EXTERNAL FORMAT
593 REM  *   EXTERNAL FORMAT IS PLACED IN BU$
594 REM  *   CHANGES A,B, A$,B$, S$
595 REM  */
600 BU$="": A=BF%(T,S): IF A < 0 THEN A=A+2: BU$="X"
610 BU$=MID$("FA",A+1,1)+BU$
620 IF BU%(T,S,0)=0 THEN 710
630 A=BU%(T,S,1): B=BU%(T,S,2): GOSUB 200: A=BU%(T,S,0)-1: GOSUB 500
640 BU$=BU$+" "+A$+"<-"+S$
650 IF BU%(T,S,3)=0 THEN 710
660 A=BU%(T,S,4): B=BU%(T,S,5): GOSUB 200: A=BU%(T,S,3)-1: GOSUB 500
670 BU$=BU$+" "+A$+"<-"+S$
680 IF BU%(T,S,6)=0 THEN 710
690 A=BU%(T,S,7): B=BU%(T,S,8): GOSUB 200: A=BU%(T,S,6)-1: GOSUB 500
700 BU$=BU$+" "+A$+"<-"+S$
710 A=LT%(T,S): B=LS%(T,S): GOSUB 200
720 BU$=BU$+"->"+A$
730 RETURN
790 REM /*
791 REM  * GOSUB 800 - CHECK WHETHER T,S ARE A VALID BLOCK ADDRESS
792 REM  *
793 REM  *  ARRAY SZ%() MUST HAVE BEEN SET UP
794 REM  *  A IS SET TO THE TRUTH VALUE FOR (T,S) IS VALID
795 REM  *
796 REM  *  B, A$,B$ ARE CHANGED IFF A IS FALSE     (IHB!)
797 REM  */
800 A = (0<T AND T<=MT) AND (0<=S AND S<SZ%(T)): IF A THEN RETURN
810 REM ** ROUTINE IS DESIGNED FOR INTERACTIVE MODE USE, SO REPORT ERROR
820 A=T:B=S: GOSUB 200
830 PRINT "CURRENT TRACK AND SECTOR PAIR ";A$;" IS BAD"
840 A = 0: RETURN
9000 DK$="0": DV=8:  OPEN 15,DV,15,"I"+DK$
9500 OU=4:INPUT"OUTPUT DEVICE (3 OR 4)";OU
9510 IF OU<>3 AND OU<>4 THEN 9500
9520 OPEN 4,4,7
9530 OPEN 3,3
10000 FC=0: FB=0: A1=0: F1=0: F2=0
10010 MT=35: MS=23: BS=3: C0$=CHR$(0)
10015 SS$=CHR$(160)
10020 DIM BM%(MT,BS), SZ%(MT): MF=145
10025 DIM LS%(MT,MS), LT%(MT,MS), DN$(MF), DE%(MF), DT%(MF), DS%(MF), DZ%(MF)
10030 DIM BF%(MT,MS): REM ** BLOCK FLAGS; 0 FREE; 1 ALLOCATED; <0 INVALID
10031 DIM BU%(MT,MS,8): REM ** BLOCK USAGE TABLE; UP TO 3 FILES
10032 DIM CC(1): REM ** COUNTER; CC(0) FREE BLOCK; CC(1) ALLOCATED
10033 DIM TY$(5): REM ** FILE TYPES
10035 DATA DEL,SEQ,PRG,USR,REL,BAD
10040 DATA 1,17,21, 18,24,19
10050 DATA 25,30,18, 31,35,17
10055 FOR I=0 TO 5: READ TY$(I): NEXT I
10060 DF=8: OPEN DF,DV,8,"$"+DK$: GOSUB 415
10070 GET#DF,A$,A$: REM ** SKIP 1ST 2 BYTES
10090 REM /*
10091 REM  * NOW INTERPRET THE BAM; READ DATA STATEMENTS TO
10092 REM  *  DETERMINE CORRECT # OF SECTORS PER TRACK
10093 REM  */
10100 FOR I=1 TO 4
10110 READ L,H,N: REM ** TRACKS L TO H HAVE N SECTORS
10120 FOR J=L TO H
10130 SZ%(J)=N
10150 GET#DF,A$: IF A$="" THEN A$=C0$
10175 A=ASC(A$): F2=F2+A: BM%(J,0)=A
10180 K1=0: FOR K=1 TO BS
10185 GET#DF,A$: IF A$="" THEN A$=C0$
10190 M=ASC(A$):BM%(J,K)=M:M2=1
10210 FOR K2=0 TO 7: A= -((M AND M2)=0): BF%(J,K1)=A: CC(A)=CC(A)+1
10230 K1=K1+1: M2=M2+M2: REM ** SHIFT M2 LEFT 1
10240 NEXT K2
10250 NEXT K
10255 REM /*
10256 REM  * EACH BAM ENTRY COULD REPRESENT 24 BLOCKS
10257 REM  * MARK AS INVALID BLOCKS GREATER THAN NUMBER IN TRACK
10258 REM  *  - NORMALLY WILL BE "ALLOCATED"; FREE WOULD BE BAD BAM
10259 REM  */
10260 K=N
10270 IF K<=MS THEN A=BF%(J,K): BF%(J,K)=A-2: CC(A)=CC(A)-1: K=K+1: GOTO 10270
10280 NEXT J
10290 NEXT I
10500 S$="": FOR I=144 TO 170
10510 GET#DF,A$: S$=S$+CHR$(ASC(A$+C0$) AND 127)
10520 NEXT I
10530 PRINT#OU,S$: REM ** DISK NAME
10540 FOR I=171 TO 255: GET#DF,A$: NEXT I: REM ** SKIP TO END OF BLOCK
10990 REM /*
10991 REM  * NOW COMPILE A LIST OF THE FILE NAMES
10992 REM  *  THEIR STARTING BLOCKS AND SIZES
10993 REM  */
11000 NF=0
11010 IF NF=0 THEN 11020: REM ** SKIP 2 BYTES EVERY 8 ENTRIES
11015 GET#DF,A$
11016 GET#DF,A$
11020 NF=NF+1: IF NF>=8 THEN NF=0
11030 GET#DF,E$: IF E$="" THEN E$=C0$
11040 GET#DF,T$,S$
11050 E=ASC(E$): REM EXTENSION
11060 T=ASC(T$+C0$): REM TRACK
11070 S=ASC(S$+C0$): REM SECTOR
11080 A=E AND 127: IF A>4 THEN A=5
11090 T$=TY$(A): IF (E AND 128)=0 THEN T$=T$+"*"
11100 S$="": I=3
11110 GET#DF,A$: IF A$<>SS$ THEN S$=S$+A$: IF I<18 THEN I=I+1: GOTO 11110
11120 IF I<27 THEN GET#DF,A$: I=I+1: GOTO 11120
11130 GET#DF,A$,B$: RS=ST
11135 X=ASC(A$+C0$)+256*ASC(B$+C0$): REM FILE SIZE (ALLEGEDLY)
11145 IF (E AND 128)=0 THEN BC=BC+1: BB=BB+X:  REM ** BADLY CLOSED FILE
11150 DN$(FC)=S$: DE%(FC)=E: DT%(FC)=T: DS%(FC)=S: DZ%(FC)=X: FB=FB+X
11155 A=T: B=S: GOSUB 200: A=FC: GOSUB 500: FC=FC+1
11160 PRINT#OU,S$;LEFT$("                    ",21-LEN(S$));X;"FROM";A$
11220 IF RS=0 THEN 11010
11250 IF RS<>64 THEN PRINT"ERROR RS=";RS
11290 REM /*
11291 REM  * NOW WE ACCESS THE DISK RANDOMLY TO BUILD A PICTURE OF
11292 REM  * THE LINKS BETWEEN THE BLOCKS ON THE DISK
11293 REM  */
11300 CLOSE DF: FOR I=1 TO 1000: NEXT I: OPEN DF,DV,8,"#"
11310 PRINT
11320 FOR T=1 TO MT
11330 PRINT "TRACK";T;CHR$(145);CHR$(13);
11340 FOR S=0 TO SZ%(T)-1
11350 PRINT#15,"U1:8,";DK$;T;S: INPUT#15,EN,EM$,ET,ES: IF EN<>0 THEN 11392
11370 GET#DF,A$: IF A$="" THEN A$=C0$
11375 LT%(T,S) = ASC(A$)
11380 GET#DF,A$: IF A$="" THEN A$=C0$
11385 LS%(T,S) = ASC(A$)
11390 NEXT S: GOTO 11400: REM ** ERROR HANDLING HERE TO SPEED SECTOR LOOP UP
11392 PRINT "DISK ERROR";EN;EM$;ET;ES: CLOSE DF: CLOSE 15
11393 OPEN 15,DV,15,"I"+DK$: OPEN DF,DV,8,"#"
11394 LT%(T,S)=-1: LS%(T,S)=-1: GOTO 11390
11400 NEXT T
11410 CLOSE DF: CLOSE 15
11510 PRINT#OU,FC-BC;"GOOD FILES TOTALLING";FB-BB;"BLOCKS"
11520 PRINT#OU,BC;"BAD FILES TOTALLING";BB;"BLOCKS"
11530 PRINT#OU,"BITMAP SHOWS";CC(1);" BLOCKS ALLOCATED;";CC(0);"(";F2;") FREE"
11540 A=INT(FC/8)+1: PRINT#OU,FC;"FILE ENTRIES IN";A;"DIRECTORY BLOCKS"
11990 REM /*
11991 REM  * NOW TRACE DOWN THE LINKED LIST OF BLOCKS FOR EACH FILE,
11992 REM  *  AND NOTE ANY INCONSISTENCIES
11993 REM  */
12000 FOR I=0 TO FC-1: REM ** FOR EACH FILE IN DIRECTORY
12020 T=DT%(I): REM ** INITIAL TRACK
12025 T1=0: REM ** INITIAL PREVIOUS TRACK (DUMMY)
12030 S=DS%(I): REM ** INITIAL SECTOR
12035 S1=0: REM ** INITIAL PREVIOUS SECTOR (DUMMY)
12040 X=DZ%(I): REM ** ALLEGED FILE SIZE
12050 J=0: REM ** BLOCK COUNTER
12060 IF 0<T AND T<=MT THEN IF 0<=S AND S<SZ%(T) THEN 12100
12065 A=T1:B=S1:GOSUB 200: A=I:GOSUB 500
12070 PRINT#OU,S$;" BAD TRACK&SECTOR POINTER; BLOCK";J;A$;
12075 A=T:B=S:GOSUB 200: PRINT#OU,"->"A$
12080 GOTO 12300
12100 J=J+1: IF BU%(T,S,0)<>0 THEN E$="MULTIPLELY ": GOTO 12110
12105 IF BF%(T,S)=1 THEN 12130
12106 E$="UN":GOSUB 200
12110 A=I: GOSUB 500: PRINT#OU,"ERROR IN ";S$;"(BLOCK";J;"):";
12115 A=T: B=S: GOSUB 200: PRINT#OU,E$;"ALLOCATED BLOCK ";A$
12120 GOSUB 600: PRINT#OU,BU$
12130 K=0
12135 IF K < 9 THEN IF BU%(T,S,K)<>0 THEN K=K+3: GOTO 12135
12136 IF K < 9 THEN BU%(T,S,K)=I+1:BU%(T,S,K+1)=T1:BU%(T,S,K+2)=S1: GOTO 12145
12140 A=T:B=S:GOSUB200:PRINT#OU,"BLOCK ";A$;" HAS TOO MANY REFERENCES TO RECORD"
12145 T1=T: S1=S: T=LT%(T1,S1): S=LS%(T1,S1)
12150 IF J<X THEN 12200
12160 IF J=X THEN IF T=0 THEN 12300: REM ** NORMAL END-OF-FILE
12170 A=T1:B=S1:GOSUB 200: A=I: GOSUB 500
12175 PRINT#OU,"FILE ";S$;" NOT ENDED AT BLOCK COUNT";X;A$;
12180 A=T:B=S:GOSUB 200: PRINT#OU,"->";A$
12190 GOTO 12300: REM ** IF WE CONTINUED ON LIST, WE MIGHT LOOP
12200 IF T<>0 THEN 12060: REM **  NORMAL GOOD BLOCK IN MIDDLE OF FILE
12205 A=T1:B=S1:GOSUB 200: A=I: GOSUB 500
12210 PRINT#OU,"FILE ";S$;" ENDS PREMATURELY:  BLOCK";J;A$;
12215 A=T:B=S:GOSUB 200: PRINT#OU,"->";A$
12300 NEXT I
12990 A$="N": INPUT"GIVE COMPLETE MAP";A$
12995 A$=LEFT$(A$,1): IF A$="N" OR A$="[206]" THEN 14000
13000 FOR T=1 TO MT
13010 PRINT#OU
13020 PRINT#OU,"TRACK";T;":";BM%(T,0);"OF";SZ%(T);"BLOCKS FREE; BAM";
13030 FOR I=1 TO BS: PRINT#OU,BM%(T,I); : NEXT I
13040 PRINT#OU
13150 S=0
13160 L=S: IF L>MS THEN 13210
13170 GOSUB 600
13175 S=S+1: IF S>MS THEN 13190
13180 IF BF%(T,S)<>BF%(T,L) THEN 13190
13181 IF BU%(T,L,0) = 0 THEN IF BU%(T,S,0) = 0 THEN 13187
13184 I=0
13185 IF I<9 THEN IF BU%(T,S,I)=BU%(T,L,I) THEN I=I+1: GOTO 13185
13186 IF I<9 GOTO 13190: REM ** NOT IDENTICAL ENTRIES FOR SUCCESSIVE SECTORS
13187 IF LT%(T,S)=LT%(T,L) THEN IF LS%(T,S)=LS%(T,L) GOTO 13175: REM IDENTICAL
13190 IF BU$="AX->(0,0)" GOTO 13160
13195 IF L=S-1 THEN PRINT#OU," SECTOR";L;BU$: GOTO 13160
13200 PRINT#OU," SECTOR";L;"TO";S-1;BU$: GOTO 13160
13210 NEXT T
13990 REM /*
13991 REM  * INTERACTIVE MODE
13992 REM  */
14000 OU=3: REM ** SET OUTPUT TO SCREEN
14010 T=0: S=0
14020 A=T: B=S: GOSUB 200: PRINT A$;
14025 INPUT "(A,B,C,D,H,F,N,O,T,$,QUIT)";A$: IF A$="QUIT" THEN 63900
14030 B$=LEFT$(A$,1): A$=RIGHT$(A$,LEN(A$)-1)
14040 IF B$="A" THEN GOSUB 14100: GOTO 14020
14045 IF B$="B" THEN GOSUB 14170: GOTO 14020
14050 IF B$="C" THEN GOSUB 14600: GOTO 14020
14055 IF B$="D" THEN GOSUB 14200: GOTO 14020
14060 IF B$="F" THEN GOSUB 14300: GOTO 14020
14065 IF B$="H" THEN GOSUB 14400: GOTO 14020
14070 IF B$="N" THEN GOSUB 14700: GOTO 14020
14075 IF B$="O" THEN GOSUB 14800: GOTO 14020
14080 IF B$="T" THEN GOSUB 14900: GOTO 14020
14085 IF B$="$" THEN GOSUB 15000: GOTO 14020
14089 PRINT"INVALID COMMAND ";B$
14090 A=OU: OU=3: GOSUB 14400: OU=A: GOTO 14020
14100 REM ** 14100 - A - ALLOCATE CURRENT T&S
14110 GOSUB 800: IF NOT A THEN RETURN
14120 OPEN 15,DV,15,"I"+DK$: OPEN DF,DV,8,"#": REM MUST OPEN TO FORCE BAM WRITE
14125 PRINT#15,"B-A:";DK$;T;S: GOSUB 315: CLOSE DF: CLOSE 15
14130 A=T:B=S:GOSUB 200
14140 IF EN=0 THEN PRINT#OU,"BLOCK ";A$;" ALLOCATED": BF%(T,S)=1: RETURN
14150 IF EN=65 THEN PRINT"BLOCK ";A$;" WAS ALREADY ALLOCATED": RETURN
14160 PRINT"UNEXPECTED DISK STATUS ";EN;EM$;ET;ES: RETURN
14170 REM ** 14170 - B - BLOCK SET CURRENT TRACK&SECTOR
14180 INPUT"TRACK,SECTOR";T,S
14190 GOSUB 800: IF A THEN GOSUB 14600
14195 RETURN
14200 REM ** 14200 - D - DIRECTORY ENTRY; DISPLAY DIRECTORY ENTRY VAL(B$)
14210 C=VAL(A$): REM  ** 14220 IS ENTRY POINT FOR OTHER ROUTINES
14220 IF 0<=C THEN IF C<FC THEN 14240
14230 PRINT "DIRECTORY ENTRY NUMBER";C;"OUT OF RANGE": RETURN
14240 A=C: GOSUB 500: T=DT%(C): S=DS%(C): A=T: B=S:  GOSUB 200
14250 PRINT#OU,C;S$;LEFT$("                        ",21-LEN(S$));
14260 PRINT#OU,DZ%(C);"FROM";A$
14270 RETURN
14300 REM ** 14300 - F - FREE; ISSUE A BLOCK-FREE FOR CURRENT BLOCK
14310 GOSUB 800: IF NOT A THEN RETURN
14320 A=T:B=S: GOSUB 200
14330 PRINT "YOU REALLY WANT TO FREE BLOCK ";A$;
14340 A$="N": INPUT A$
14350 A$=LEFT$(A$,1): IF A$<>"Y" THEN IF A$<>"[217]" THEN RETURN
14360 OPEN 15,DV,15,"I"+DK$: OPEN DF,DV,8,"#": REM MUST OPEN TO FORCE BAM WRITE
14365 PRINT#15,"B-F:";DK$;T;S: GOSUB 315: CLOSE DF: CLOSE 15
14370 A=T:B=S:GOSUB 200
14380 IF EN=0 THEN PRINT#OU,"BLOCK ";A$;" FREED": BF%(T,S)=0: RETURN
14390 PRINT"UNEXPECTED DISK STATUS ";EN;EM$;ET;ES;" ON BLOCK-FREE"
14395 RETURN
14400 REM ** 14400 - H - HELP; GET SOME HELP
14410 PRINT#OU,"A - ALLOCATE CURRENT T&S (FOR REAL, ON DISK)"
14420 PRINT#OU,"B - BLOCK; SET T&S (PROMPTED FOR)"
14430 PRINT#OU,"C - CURRENT; DISPLAY MAP ENTRY FOR CURRENT T&S"
14440 PRINT#OU,"D<N> - DIRECTORY; DISPLAY DIRECTORY ENTRY N"
14450 PRINT#OU,"F - FREE CURRENT T&S (FOR REAL, ON DISK-BE CAREFUL!)"
14460 PRINT#OU,"H - HELP; GET THIS LIST ON OUTPUT DEVICE"
14470 PRINT#OU,"N - NEXT; DISPLAY CURRENT MAP ENTRY THEN GO TO NEXT LINK"
14480 PRINT#OU,"O<N> - OUTPUT; SEND (MOST) OUTPUT TO DEVICE N (3 OR 4)"
14485 PRINT#OU,"T - TRACE; TRACE BLOCK LIST FROM CURRENT T&S"
14490 PRINT#OU,"$ - DISPLAY ENTIRE DIRECTORY OR LOOK FOR FILE NAME"
14500 PRINT#OU,"QUIT - QUIT; PUT AN END TO ALL THIS NONSENSE"
14510 RETURN
14600 REM ** 14600 - C - CURRENT; DISPLAY THE MAP ENTRY FOR CURRENT T&S
14610 GOSUB 800: IF NOT A THEN RETURN
14620 GOSUB 600: A=T:B=S: GOSUB 200
14630 PRINT#OU,A$;":";BU$
14640 RETURN
14700 REM ** 14700 - N - NEXT; DISPLAY CURRENT MAP ENTRY, SET T&S TO NEXT
14710 GOSUB 800: IF NOT A THEN RETURN
14720 GOSUB 14600
14730 A=T: T=LT%(T,S): S=LS%(A,S)
14740 RETURN
14800 REM ** 14800 - O - OUTPUT; SET OUTPUT DEVICE
14810 A=VAL(A$): IF 3<=A THEN IF A<=4 THEN OU=A: RETURN
14820 PRINT "INVALID OUTPUT DEVICE (MUST BE 3 OR 4)";A
14830 RETURN
14900 REM ** 14900 - T - TRACE; FOLLOW THE CURRENT LIST OF BLOCKS
14910 GOSUB 800:  IF NOT A THEN RETURN
14915 GET A$: IF A$<>"" THEN 14915
14920 GOSUB 14700: GET A$: IF A$<>"" THEN RETURN
14930 IF 1<=T AND T<=MT THEN IF 0<=S AND S<=SZ%(T) GOTO 14920
14940 RETURN
15000 REM ** 15000 - $ - SHOW DIRECTORY, OR SET CURRENT BLOCK FROM FILE
15010 IF A$="" THEN FOR I=0 TO FC-1: C=I: GOSUB 14220: NEXT I: RETURN
15020 C=0
15030 IF C >= FC THEN PRINT"NO SUCH FILE AS ";A$: RETURN
15040 IF DN$(C)<>A$ THEN C=C+1: GOTO 15030
15050 GOSUB 14220
15060 RETURN
63900 CLOSE 3: CLOSE 4: CLOSE DF: CLOSE 15
63999 END